#!/usr/bin/perl

use constant DEBUG => 0; # 0/1 desactiva/activa print de debug
use constant VERBOS => 0; # 0/1 desactiva/activa procesado dos verbos (precisa arquivo de verbos)

#binmode(STDOUT, ":utf8");
#binmode(STDIN, ":utf8");

#use strict;
use locale;
use POSIX;
use utf8;

#setlocale(LC_CTYPE,"pt_PT);

# Cabeceira html
print "Content-type:text/html\r\n\r\n";
print "<html>";
print "<head>";
print "<title>Prova web rag2agal</title>";
print "</head>";
print "<body>";
print "<h2>Prova web rag2agal</h2>";
print "<form action='/cgi-bin/rag2agal.cgi' method='POST'>";
print "<p><b>Texto em RAG:</b></p>";
print "<textarea cols='50' rows='5' name='inputText'>$inputText</textarea>";
print "<input type='submit' value='Adaptar'></form>";

#print "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%\n";
#print " TRANSLITERAÇOM AUTOMÁTICA DO GALEGO RAG AO GALEGO AGAL  (excusas polos erros)  \n";
#print "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%\n";
#print "\n";
#print "\n";

if (DEBUG){
	print "- modo DEBUG ON - ";
	if (VERBOS){
		print "- procesado de VERBOS ON -";
	}else{
		print "- procesado de VERBOS OFF -";
	}
}

#use strict;
#use warnings;
#use CGI;

# Procesamos a entrada
    local ($buffer, @pairs, $pair, $name, $value, %FORM);
    # Read in text
    $ENV{'REQUEST_METHOD'} =~ tr/a-z/A-Z/;
    if ($ENV{'REQUEST_METHOD'} eq "POST")
    {
        read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
    }else {
	$buffer = $ENV{'QUERY_STRING'};
    }
    # Split information into name/value pairs
    @pairs = split(/&/, $buffer);
    foreach $pair (@pairs)
    {
	($name, $value) = split(/=/, $pair);
	$value =~ tr/+/ /;
	$value =~ s/%(..)/pack("C", hex($1))/eg;
	$FORM{$name} = $value;
    }
    $inputText = $FORM{inputText};


my $vogal =  "AEIOUaeiou";
my $consAll = "bBdDtTpPkKvVfFcCçÇzZkKlLrRnNmMpPjJxXsShHqQgGñÑ";

my $vogalacentuada =  "\[áàéíóúÁÀÉÍÓÚâêîôûüãÃõÕ\]";
my $symbol = "\[\?\!\¿\¡\%\&\/\(\)\+\*\"\=\.\,\;\:\]";
my $WChar = "(\[a-zA-ZáàéíóúÁÀÉÍÓÚçÇâêîôûüãÃõÕ\])";
my $NaoChar = "(\[ \?\!\¿\¡\%\&\/\(\)\+\*\"\'\=\.\,\;\:\])";
my $cons =  "(\[bBdDtTpPkKvVfFcCçÇzZkKlLrRnNmMpPjJxXsShHñÑ\])"; ##faltam q e g
my $crecente =  "(ia|ie|io|ue|ua|uo|gua|guo)";
my $decrecente = "(iu|eu|ei|oi|ou|ai|au)";
my $w = "a-zA-ZáàéíóúÁÀÉÍÓÚçÇâêîôûüãÃõÕäÄëËïÏöÖüÜ";
my $regras = "003";

##############################################################
# REGRAS GERAL
# #############################################################

#open(FILE, "<regrasgeral.txt") or die "ERROR: Nom podo ler o regrasgeral.txt: $!\n";
#my @la = <FILE>;
#close(FILE);
#my @l = grep {!/^#/} @la; # weed out comments


#if (DEBUG){print "<p>REGRAS $#l $l[0]: @l</p>";}




my @l = qw(
);


my $line =  $inputText ;

# Necessárias para os verbos
my $v;
my $inf3;
my $inf2;
my $inf1;
my $raiz;
my @VerbsAR = ();
my @VerbsER = ();
my @VerbsIR = ();
my $VerbsARq = 0;
my $VerbsERq = 0;
my $VerbsIRq = 0;
my $file;
# Se estamos sendo executados com VERBOS temos que percorrer o arquivo de verbos

if (VERBOS){
	if (DEBUG){print "<p>Procesamos VERBOS</p>";}
	open (FILE, "./verbosAGAL.txt") or die "<p>O ficheiro não pode ser aberto: $!</p>";
	while ($v = <FILE>) {
		chomp $v;
		if ($v =~ /ir$/) {
			$VerbsIR[$VerbsIRq++] = $v;
		}elsif ($v =~ /er$/) {
			$VerbsER[$VerbsERq++] = $v;
		}elsif ($v =~ /ar$/) {
			$VerbsAR[$VerbsARq++] = $v;
		}
	}
	#if (DEBUG){print "<p>Verbos-AR ($VerbsARq): @VerbsAR</p>";}
	#if (DEBUG){print "<p>Verbos-ER ($VerbsERq): @VerbsER</p>";}
	#if (DEBUG){print "<p>Verbos-IR ($VerbsIRq): @VerbsIR</p>";}
	if (DEBUG){print "<p>Verbos-AR ($VerbsARq); Verbos-ER ($VerbsERq); Verbos-IR ($VerbsIRq)</p>";}
}#VERBOS


    #chop $line; #borra o último caracter, será por borrar o \n?

    #if (DEBUG){print "line01=-$line-\n";}
    #ilhamos as palavras (podem estar entre signos de pontoaçom ou cousas assim
    #line01=<esto[illa](os), valores,claro, que están;entre;puntiacións.asi.>
    #line02=<  esto[ illa ] ( os )  ,  valores,claro ,  que  están;entre;puntiacións.asi .  >
    
    $line = " $line ";
    $line =~ s/ /  /g;
    $line =~ s/\. / \. /g;
    $line =~ s/\.$/ \. /g;
    $line =~ s/\, / \, /g;
    $line =~ s/\; / \; /g;
    $line =~ s/\?/ \? /g;
    $line =~ s/\!/ \! /g;
    $line =~ s/\[/\[ /g;
    $line =~ s/\]/ \] /g;
    $line =~ s/\(/\( /g;
    $line =~ s/\)/ \) /g;
    $line =~ s/\"/ \" /g;
    #if (DEBUG){print "line02=-$line-\n";}


    #trocas da lista de pares irregulares $l:
    # Aqui busca cada uma das regras ($l), fazendo pares ($a regra a cumprir, $b a executar
    my $i;
    for ($i=0;$i<$#l;$i+=2) {# autoincrementa 2 porque salta, a b, porque cada regra está composta por 2 strings, 'a' e 'b'
        my ($a,$b) = ($l[$i],$l[$i+1]);
        #if (DEBUG){print STDERR "a b=-$a- -$b-\n";}
        #$a =~ s/^([^\?-])/(\\W)$1/;
        #$a =~ s/([^\?-])$/$1(\\W)/;
        $a =~ s/^([^\?-])/$NaoChar$1/;
        $a =~ s/([^\?-])$/$1$NaoChar/;

        #$a =~ s/(^-|-$)/(\\w)/g;
        $a =~ s/(^-|-$)/$WChar/gi;
        $a =~ s/(^\?|\?$)/(.)/gi;
        $a =~ s/\)\(//gi;
        #if (DEBUG){print STDERR "a b=-$a- -$b-\n";}
        # $line =~ s/$a/$1$b$2/gi;
        $line =~ s/$a/$1$b$2/gi;
        #if (DEBUG){print STDERR "line=-$line-\n";}
    }
    $line =~ s/  / /g;
    $line =~ s/^ //g;
    $line =~ s/ $//g;
    #$line =~ s/ \n /\n/g;
    if (DEBUG){print "<p>Rematamos GERAL:</p>";}
    if (DEBUG){print "<p>$line</p>";}

    #Umha vez aqui podemos substituir conjuntos de palavras, expressões
########################################################################
# REGRAS EXPRESSÕES
########################################################################
    #    $line =~ s/[dD]e cotio/*amiúde/g;
    $line =~ s/([aA]) pesar/$1pesar/g;
    $line =~ s/([cC])oma ti/$1omo tu/g;
    $line =~ s/([cC])oma mim/$1omo eu/g;
    $line =~ s/([cC])oma sempre/$1omo sempre/g;
    $line =~ s/([cC])oma nunca/$1omo nunca/g;


    my $SpetialChar = "\?\!\¿\¡\%\&\/\(\)\\\+\*\'\=\.\,\;\: ";

    $line =~ s/ \. /\. /g;
    $line =~ s/ \.$/\./g;
    $line =~ s/ \; /\; /g;
    $line =~ s/ \, /\, /g;
    $line =~ s/ \? /\? /g;
    $line =~ s/ \! /\! /g;
    $line =~ s/\[ /\[/g;
    $line =~ s/ \] /\] /g;
    $line =~ s/\( /\(/g;
    $line =~ s/ \) /\) /g;

    $line =~ s/\" ([$w$SpetialChar]*) \"/\"$1\"/g;
    $line =~ s/ ([\]\)])($SpetialChar)/$1$2/g;

####################################
# REGRAS VERBOS
####################################
    if (VERBOS){
	my @listPals;
	my $p;
	(@listPals) = split (" ", $line);
	$line="";
	foreach $p (@listPals) {
		##comi -> comim
		if ($p =~ /i($symbol?)($symbol?)$/) {
			($raiz) = split ("i", $p);
			#print "raiz=$raiz\n";
			$inf3 = $raiz . "ir";
			#print "inf3=$inf3\n";
			$inf2 = $raiz . "er";
			#print "inf2=$inf2\n";
			if ( ( $inf3 ~~ @VerbsIR ) || ( $inf2 ~~ @VerbsER ) ){
				#if ( (defined $VerbsIR{$inf3}) || (defined $VerbsER{$inf2}) ) {
				$p =~ s/i($symbol?)($symbol?)$/im$1$2/;
			}
		}
		##-ão -> ám
		elsif ($p =~ /ão($symbol?)($symbol?)$/) {
			#print "BEM!\n";
			($raiz) = split ("ã", $p);
			#print "raiz=$raiz\n";
			$inf3 = $raiz . "ir";
			#print "inf3=$inf3\n";
			$inf2 = $raiz . "er";
			#print "inf2=$inf2\n";
			if ( ( $raiz ~~ @VerbsIR ) || ( $raiz ~~ @VerbsER ) || ( $raiz ~~ @VerbsAR ) ){
				#if ( (defined $VerbsIR{$raiz}) || (defined $VerbsER{$raiz}) || (defined $VerbsAR{$raiz}) ) {
				#print "RE-BEM\n";
				$p =~ s/ão($symbol?)($symbol?)$/ám$1$2/;
			}
		}
#=pod #acho que isto deveu ser umha linha errada
		##-aba -> ava
		elsif ($p =~ /[aá]ba((?:mos|des))($symbol?)($symbol?)$/) {
			print "BEM!\n";
			($raiz) = split ("[aá]ba", $p);
			@raizes = split (("[aá]ba"), $p);
			print "raiz=$raiz\n";
			print "raizes0=$raizes[0]\n";
			print "raizes1=$raizes[1]";
			#print "raiz1=$raiz[1]";
			#print "raiz2=$raiz[2]";
			$inf3 = $raiz . "ir";
			#print "inf3=$inf3\n";
			$inf2 = $raiz . "er";
			#print "inf2=$inf2\n";
			$inf1 = $raiz . "ar";
			#print "inf1=$inf1\n";
			if ( ( $inf1 ~~ @VerbsAR ) ){
				#if ( (defined $VerbsAR{$inf1}) ) {
				$p =~ s/[aá]ba((?:mos|des))($symbol?)($symbol?)$/áva$1$2$3/;
			}
		}
#=cut #acho que isto deveu ser umha linha errada
		##-aba -> ava
		elsif ($p =~ /aba((?:n|m|s)?)($symbol?)($symbol?)$/) {
			#print "BEM!\n";
			($raiz) = split ("aba", $p); #parentesis para manter o spliter, e dize
			#print "raiz=$raiz\n";
			$inf3 = $raiz . "ir";
			#print "inf3=$inf3\n";
			$inf2 = $raiz . "er";
			#print "inf2=$inf2\n";
			$inf1 = $raiz . "ar";
			#print "inf1=$inf1\n";
			if ( ( $inf1 ~~ @VerbsAR ) ){
				#if ( (defined $VerbsAR{$inf1}) ) {
				$p =~ s/aba((?:n|m|s)?)($symbol?)($symbol?)$/ava$1$2$3/;
			}
		}
		##-ase -> asse
		elsif ($p =~ /ase((?:n|m|s)?)($symbol?)($symbol?)$/) {
			#print "BEM!\n";
			($raiz) = split ("ase", $p);
			#print "raiz=$raiz\n";
			$inf3 = $raiz . "ir";
			#print "inf3=$inf3\n";
			$inf2 = $raiz . "er";
			#print "inf2=$inf2\n";
			$inf1 = $raiz . "ar";
			#print "inf1=$inf1\n";
			if ( ( $inf1 ~~ @VerbsAR ) ){
				#if ( (defined $VerbsAR{$inf1}) ) {
				$p =~ s/ase((?:n|m|s)?)($symbol?)($symbol?)$/asse$1$2$3/;
			}
		}
		##-ase -> asse
		elsif ($p =~ /[aá]se((?:mos|des))($symbol?)($symbol?)$/) {
			#print "BEM!\n";
			($raiz) = split ("[aá]se", $p);
			#print "raiz=$raiz\n";
			$inf3 = $raiz . "ir";
			#print "inf3=$inf3\n";
			$inf2 = $raiz . "er";
			#print "inf2=$inf2\n";
			$inf1 = $raiz . "ar";
			#print "inf1=$inf1\n";
			if ( ( $inf1 ~~ @VerbsAR ) ){
				#if ( (defined $VerbsAR{$inf1}) ) {
				$p =~ s/[aá]se((?:mos|des))($symbol?)($symbol?)$/ásse$1$2$3/;
			}
		}
		##-emento -> imento
		elsif ($p =~ /emento(s?)($symbol?)($symbol?)$/) {
			#print "BEM!\n";
			($raiz) = split ("emento", $p);
			#print "raiz=$raiz\n";
			$inf3 = $raiz . "ir";
			#print "inf3=$inf3\n";
			$inf2 = $raiz . "er";
			#print "inf2=$inf2\n";
			$inf1 = $raiz . "ar";
			#print "inf1=$inf1\n";
			if ( ( $inf3 ~~ @VerbsIR ) || ( $inf2 ~~ @VerbsER ) ){
				#if ( (defined $VerbsIR{$inf3}) || (defined $VerbsER{$inf2}) ) {
				$p =~ s/emento(s?)($symbol?)($symbol?)$/imento$1$2$3/;
			}
		}
		##Hífen nos infinitivos com pronome
		elsif ($p =~ /(?:se|lh[eoa]s?|m[eoa]s?|n[oa]s|vos|te|ch[eoa]s?)($symbol?)($symbol?)$/) {
			#print "BEM!\n";
			($raiz) = split ("(?:se|lh[eoa]s?|m[eoa]s?|n[oa]s|vos|te|ch[eoa]s?)($symbol?)", $p);
			#print "raiz=$raiz\n";
			$inf3 = $raiz . "ir";
			#print "inf3=$inf3\n";
			$inf2 = $raiz . "er";
			#print "inf2=$inf2\n";
			$inf1 = $raiz . "ar";
			#print "inf1=$inf1\n";
			if ( ( $raiz ~~ @VerbsIR ) || ( $raiz ~~ @VerbsER ) || ( $raiz ~~ @VerbsAR ) ){
				#if ( (defined $VerbsIR{$raiz}) || (defined $VerbsER{$raiz}) || (defined $VerbsAR{$raiz}) ) {
				#print "RE-BEM\n";
				$p =~ s/((?:se|lh[eoa]s?|m[eoa]s?|n[oa]s|vos|te|ch[eoa]s?)($symbol?))($symbol?)($symbol?)$/-$1$2$3/;
			
			}
		}
		


$line .= $p . " ";
      }#foreach
      if (DEBUG){print "<p>Rematamos VERBOS:</p>";}
      if (DEBUG){print "<p>$line</p>";}
    }#VERBOS

    print "<p><b>Texto em AGAL (v.$regras):</b></p>";
#    print "<textarea disabled cols='120' rows='20' name='inputText'>$line</textarea>";

    print "<textarea readonly cols='120' rows='20' name='inputText'>$line</textarea>";

####################
# FIM
# ########################################

sub PorAcento {
    my $result;
    my $x;

    ($x) = $_[0];


    if ($x eq "a") {$result = "á"};
    if ($x eq "e") {$result = "é"};
    if ($x eq "i") {$result = "í"};
    if ($x eq "o") {$result = "ó"};
    if ($x eq "u") {$result = "ú"};
    if ($x eq "A") {$result = "Á"};
    if ($x eq "E") {$result = "É"};
    if ($x eq "I") {$result = "Í"};
    if ($x eq "O") {$result = "Ó"};
    if ($x eq "U") {$result = "Ú"};
    return $result;

}

sub TirarAcento {
    my $result;
    my $x;

    ($x) = $_[0];


    if ($x eq "á") {$result = "a"};
    if ($x eq "é") {$result = "e"};
    if ($x eq "í") {$result = "i"};
    if ($x eq "ó") {$result = "o"};
    if ($x eq "ú") {$result = "u"};
    if ($x eq "Á") {$result = "A"};
    if ($x eq "É") {$result = "E"};
    if ($x eq "Í") {$result = "I"};
    if ($x eq "Ó") {$result = "O"};
    if ($x eq "Ú") {$result = "U"};
    return $result;

}


sub pertence {
    my $subcadeia;
    my $cadeia;
    my $temp;

    ($subcadeia) = $_[0];
    ($cadeia) = $_[1];

    $temp = "|" . $subcadeia . "|";
    if (index ($cadeia, $temp) ==-1) {
        return 0;
    }
    else {
        return 1;
    }
}

print "</body>";
print "</html>";

1;
